home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 38 / Amiga Format CD38 (1999-03-15)(Future Publishing)(GB)(Track 1 of 3)[!][issue 1999-04].iso / -seriously_amiga- / programming / other / cyberxxxsrc / misc / dossupport.mod < prev    next >
Text File  |  1999-02-08  |  4KB  |  110 lines
  1. MODULE  DosSupport;
  2.  
  3. (* $StackChk- $OvflChk- $RangeChk- $CaseChk- $ReturnChk- $NilChk- $TypeChk- $OddChk- $ClearVars- *)
  4.  
  5. (* /// ------------------------------- "IMPORT" -------------------------------- *)
  6. IMPORT  d:=Dos,
  7.         e:=Exec,
  8.         ol:=OberonLib,
  9.         y:=SYSTEM;
  10. (* \\\ ------------------------------------------------------------------------- *)
  11.  
  12. (* /// -------------------------------- "TYPE" --------------------------------- *)
  13. TYPE    DoProc * =PROCEDURE (ap: d.AnchorPathPtr;
  14.                              multi: BOOLEAN): LONGINT;
  15. (* \\\ ------------------------------------------------------------------------- *)
  16.  
  17. (* /// ----------------------- "PROCEDURE DoAllFiles()" ------------------------ *)
  18. PROCEDURE DoAllFiles * (files: d.ArgStringArray;
  19.                         doAll: BOOLEAN;
  20.                         doProc: DoProc): BOOLEAN;
  21.  
  22. VAR     cnt: LONGINT;
  23.         retVal: LONGINT;
  24.         anchor: d.AnchorPathPtr;
  25.         oldCD: d.FileLockPtr;
  26.         doProcResult: LONGINT;
  27.         multi: BOOLEAN;
  28.         prgName: e.STRING;
  29.  
  30. (* /// -------------------------- "PROCEDURE IsDir()" -------------------------- *)
  31.   PROCEDURE IsDir(): BOOLEAN;
  32.   BEGIN
  33.     RETURN (anchor.info.dirEntryType>=d.root) & (anchor.info.dirEntryType#d.softLink);
  34.   END IsDir;
  35. (* \\\ ------------------------------------------------------------------------- *)
  36.  
  37. BEGIN
  38.   y.SETREG(0,d.GetProgramName(prgName,SIZE(prgName)));
  39.   cnt:=0;
  40.   WHILE files[cnt]#NIL DO INC(cnt); END;
  41.   multi:=(cnt>1);
  42.   anchor:=e.AllocVec(SIZE(anchor^)+SIZE(e.STRING),e.any+LONGSET{e.memClear});
  43.   IF anchor=NIL THEN
  44.     retVal:=d.noFreeStore;
  45.   ELSE
  46.     anchor.breakBits:=LONGSET{d.ctrlC};
  47.     anchor.foundBreak:=LONGSET{};
  48.     anchor.flags:=SHORTSET{};
  49.     anchor.strLen:=SIZE(e.STRING);
  50.     cnt:=0;
  51.     doProcResult:=0;
  52.     REPEAT
  53.       retVal:=d.MatchFirst(files[cnt]^,anchor^);
  54.       WHILE (retVal=0) & (doProcResult#d.break) DO
  55.         IF IsDir() THEN
  56.           IF ~(d.didDir IN anchor.flags) & doAll THEN INCL(anchor.flags,d.doDir); END;
  57.           EXCL(anchor.flags,d.didDir);
  58.         ELSE
  59.           oldCD:=d.CurrentDir(anchor.last.lock);
  60.           doProcResult:=doProc(anchor,multi OR (d.itsWild IN anchor.flags));
  61.           y.SETREG(0,d.CurrentDir(oldCD));
  62.         END;
  63.         IF doProcResult#d.break THEN
  64.           IF doProcResult#0 THEN y.SETREG(0,d.PrintFault(doProcResult,anchor.info.fileName)); END;
  65.           retVal:=d.MatchNext(anchor^);
  66.         ELSE
  67.           y.SETREG(0,d.PrintFault(doProcResult,anchor.info.fileName));
  68.         END;
  69.       END;
  70.       d.MatchEnd(anchor^);
  71.       INC(cnt);
  72.     UNTIL (files[cnt]=NIL) OR (doProcResult=d.break) OR (retVal=d.noMoreEntries);
  73.     e.FreeVec(anchor);
  74.   END;
  75.   IF (retVal#0) & (retVal#d.noMoreEntries) THEN
  76.     y.SETREG(0,d.PrintFault(retVal,prgName));
  77.   END;
  78.   RETURN (doProcResult=0) & (retVal=d.noMoreEntries);
  79. END DoAllFiles;
  80. (* \\\ ------------------------------------------------------------------------- *)
  81.  
  82. (* /// -------------------------- "PROCEDURE Fail()" --------------------------- *)
  83. PROCEDURE Fail * (err: LONGINT;
  84.                   haltErr: LONGINT);
  85. BEGIN
  86.   IF err#0 THEN
  87.     IF err=-1 THEN err:=d.IoErr(); END;
  88.     y.SETREG(0,d.PrintFault(err,NIL));
  89.   END;
  90.   ol.Result:=haltErr;
  91.   ol.HaltProc();
  92. END Fail;
  93. (* \\\ ------------------------------------------------------------------------- *)
  94.  
  95. (* /// ------------------------- "PROCEDURE B2CStr()" -------------------------- *)
  96. PROCEDURE B2CStr * (bstr: ARRAY OF CHAR;
  97.                     VAR cstr: ARRAY OF CHAR); (* $CopyArrays- *)
  98.  
  99. VAR     x: INTEGER;
  100.  
  101. BEGIN
  102.   FOR x:=0 TO ORD(bstr[0])-1 DO
  103.     cstr[x]:=bstr[x+1];
  104.   END;
  105.   cstr[x]:=00X;
  106. END B2CStr;
  107. (* \\\ ------------------------------------------------------------------------- *)
  108.  
  109. END DosSupport.
  110.